home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / formnew.zip / FORMNEW.COD next >
Text File  |  1990-08-30  |  40KB  |  1,247 lines
  1. // Module Name: FORMNEW.COD FOR 1.1
  2. // Description: This module produces dBASE IV .FMT files
  3. //              with popups for VALID clause field validation and
  4. //              Context Sensitive Help for each field
  5. //
  6.  
  7. Format (.fmt) File Template with POPUP field validation
  8. -------------------------------------------------------
  9. Version 1.1.19
  10. (  Subversion 1.  Modified by B. Flynn  8/3/90 - SIG ID BFlynn
  11.    Changes: * If DOS variable DTL_REQUIRED exists and is set to ASK,
  12.               ask user if REQUIRED should be inserted.  If DTL_REQUIRED is
  13.               set to anything else, automatically insert REQUIRED w/o
  14.               asking. (ex. SET DTL_REQUIRED=ON)
  15.             * Ignore 1x1 memo boxes (allows user to open
  16.               memo marker to full-screen edit mode).
  17.             * No KEYBOARD reference in lookup program for character fields.
  18. )
  19. Ashton-Tate (c) 1987, 1988, 1989, 1990
  20. Written by Kirk J. Nason & Bill Ramos
  21.  
  22. This template will support POPUPs for VALID clause field validations and
  23. context sensitive help for each field.
  24.  
  25. Example: In "ACCEPT value when" under "Edit options" enter,
  26.         "POPUP" = "vendor->vendor_id ORDER vendor_id REQ SHADOW"
  27.         --------------------------------------------------------
  28.         this will activate a popup if the data entered is invalid for
  29.         that field and will also make the field REQUIRED.
  30.  
  31. Explanation of the POPUP string follows:
  32.  
  33. POPUP              Indicates that a popup will be used for this field.
  34. vendor->vendor_id  Indicates the .DBF to open and FIELD to use as validation.
  35. ORDER vendor_id    Indicates which INDEX TAG to SEEK in.
  36. REQ                Indicates the FIELD requires data (can't be empty).
  37.                    Leave REQ out if the field is NOT required.      OPTIONAL!
  38. SHADOW             Use shadowing effect on popups                   OPTIONAL!
  39. NOTE: The POPUP string must be entered with the quotes as in the example.
  40.  
  41. --------------------------------------------------------------------------------
  42.  
  43. Explanation of the Context Sensitive Help file follows:
  44.  
  45. If you want to create your own help file, here is the structure that is required.
  46.  
  47. Structure for Help Database (.dbf):
  48. <first 6 chars. of the format file name>_H.dbf
  49.  
  50. Field   Field Name  Type        Width  Dec   Tag
  51. -------------------------------------------------
  52.     1   FLD_NAME    Character     10         Yes  Field name to lookup on F1
  53.     2   FLD_HEADNG  Character     25          No  Heading to show user on window
  54.     3   FLD_HELP    Memo          10          No  Help text to show user
  55. -------------------------------------------------
  56.         Total                     46
  57. {
  58. include "form.def"    // Form selectors
  59. include "builtin.def" // Builtin functions
  60. //
  61. // Enum string constants for international translation
  62. //
  63. enum  wrong_class = "Can't use FORM.GEN on non-form objects.  ",
  64.       form_empty  = "Form design was empty.  ",
  65.       bad_pick    = "Picklist coordinates exceed column 79 - move field left",
  66.       bad_shadow  = "Shadow coordinates exceed column 79 - move field left",
  67.       select_msg1 = "[Select: ]+CHR(17)+CHR(196)+CHR(217)+[   Cancel: Esc]",
  68.       help_msg1   = "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Esc   ",
  69.       help_msg2   = "See Original Screen: F3",
  70.       require_msg = "Would you like the REQUIRED keyword after all VALID and RANGE options?"    //Modified by B. Flynn.  8/3/90
  71. ;
  72. enum  offset = 3; // Offset for lmarg()
  73. //
  74.  
  75. if FRAME_CLASS != form then // We are not processing a form object
  76.   pause(wrong_class + any_key)
  77.   goto NoGen;
  78. endif
  79.  
  80. var  fmt_name,     // Format file name
  81.      crlf,         // line feed
  82.      carry_flg,    // Flag to test carry loop
  83.      carry_cnt,    // Count of the number of fields to carry
  84.      carry_len,    // Cumulative length of carry line until 75 characters
  85.      carry_lent,   // Total cumulative length of carry line
  86.      carry_first,  // Flag to test "," output for carry fields
  87.      color_flg,    // Flag to if color should stay on am line
  88.      line_cnt,     // Count for total lines processed (Mulitple page forms)
  89.      page_cnt,     // Count for total pages processed (Mulitple page forms)
  90.      temp,         // tempory work variable
  91.      cnt,          // Foreach loop variable
  92.      wnd_cnt,      // Window counter
  93.      wnd_names,    // Window names so I can clear them at the bottom of the file
  94.      default_drv,  // dBASE default drive
  95.      dB_status,    // dBASE status before entering designer
  96.      scrn_size,    // Screen size when generation starts
  97.      left_delimiter, // Delimiter to put around SAY
  98.      right_delimiter,// Delimiter to put around SAY
  99.      max_pop_row,  // Maximum row that a popup or shadow can start
  100.      display,      // Type of display screen we are on
  101.      is_popup,     // POPUP validation requested
  102.      is_help,      // HELP (context sensitive) requested
  103.      udf_file,     // UDF file has been created
  104.      hlp_name,     // HELP .dbf name
  105.      trow_positn,  // Temporary variable for row_positn
  106.      tcol_positn,  // Temporary variable for col_positn
  107.      at_pop,       // "POPUP" is in FLD_OK_COND
  108.      color,        // Color returned from getcolor function
  109.      get_required; // Modified by B. Flynn.  8/3/90
  110.  
  111.  //-----------------------------------------------
  112.  // Assign default values to some of the variables
  113.  //-----------------------------------------------
  114.  get_required = ""
  115.  carry_flg = carry_first = carry_cnt = carry_len = carry_lent =
  116.  wnd_cnt = line_cnt =  color_flg = cnt = 0
  117.  crlf = chr(10)
  118.  temp = ""
  119.  page_cnt = 1
  120.  is_popup = is_help = udf_file = 0
  121.  left_delimiter = right_delimiter = "\""
  122.  
  123.  screen_size()
  124.  //-------------------------------
  125.  // Create Format file
  126.  //-------------------------------
  127.  if !make_Fmt() then goto nogen
  128.  
  129.  // Modified by B. Flynn.  8/3/90
  130.    if upper(getenv("DTL_REQUIRED")) == "ASK" then
  131.       retry:
  132.          get_required = ASKUSER(require_msg,"Y",1);
  133.          if not at(upper(get_required),"YN") then GOTO retry endif
  134.          if upper(get_required) == "N" then get_required = ""; endif
  135.    else
  136.       if GETENV("DTL_REQUIRED") then get_required = "R"; endif
  137.    endif
  138.  
  139.  header()                   // Print Header in the Format file
  140.  fmt_file_initialization()  // Format file initializtion code
  141.  fmt_file_body()            // @ SAY GET Processing
  142.  fmt_file_exit()            // Format file exit code
  143.  make_pop_code()            // Create the Procedure File for POPUP's if required
  144.  make_help_code()           // Make procedures for the help system
  145.  
  146.  if cnt == 0 then
  147.     pause(form_empty + any_key)
  148.  endif
  149.  fileerase(fmt_name+".FMO")
  150.  nogen:
  151. return 0;
  152.  
  153.  
  154. //---------------------------------------
  155. // Template user defined functions follow
  156. //---------------------------------------
  157.  
  158. define fmt_file_initialization()
  159. //
  160. // Format file initialization code
  161. //
  162. }
  163.  
  164. *-- Format file initialization code --------------------------------------------
  165.  
  166. *-- Some of these PRIVATE variables are created based on CodeGen and may not 
  167. *-- be used by your particular .fmt file
  168. PRIVATE lc_talk, lc_cursor, lc_display, lc_status, lc_carry, lc_proc,;
  169.         ln_typeahd, gc_cut
  170.  
  171. IF SET("TALK") = "ON"
  172.    SET TALK OFF
  173.    lc_talk = "ON"
  174. ELSE
  175.    lc_talk = "OFF"
  176. ENDIF
  177. lc_cursor = SET("CURSOR")
  178. SET CURSOR ON
  179. {if at("43", display_type()) then}
  180.  
  181. *-- This form was created in {display_type()} mode
  182. lc_display = SET("display")
  183. // MONO, COLOR, EGA25, EGA43, MONO43
  184. IF .NOT. "43" $ lc_display                             && In 25 line mode
  185.    IF "EGA" $ lc_display
  186.       *-- If EGA is in lc_display try EGA43
  187.       SET DISPLAY TO EGA43                     
  188.    ELSE
  189.       *-- Otherwise try MONO43
  190.       SET DISPLAY TO MONO43
  191.    ENDIF
  192. ENDIF
  193. {endif}
  194.  
  195. lc_status = SET("STATUS")
  196. *-- SET STATUS was \
  197. {if dB_status then}
  198. ON when you went into the Forms Designer.
  199. IF lc_status = "OFF"
  200.    SET STATUS ON
  201. {else}
  202. OFF when you went into the Forms Designer.
  203. IF lc_status = "ON"
  204.    SET STATUS OFF
  205. {endif}
  206. ENDIF
  207. //-----------------------------------------------------------------------
  208. // Process fields to build "SET CARRY" and WINDOW commands.
  209. //-----------------------------------------------------------------------
  210. {
  211.  foreach FLD_ELEMENT flds
  212.    new_page(flds)
  213.    if FLD_CARRY then carry_flg = 1; ++carry_cnt endif
  214.    if chr(FLD_VALUE_TYPE) == "M" and FLD_MEM_TYP and wnd_cnt < 20
  215.       and not (BOX_HEIGHT <= 3 and BOX_WIDTH <= 3) then  //Modified 8/3/90 B. Flynn
  216.       ++wnd_cnt
  217.       wnd_names = wnd_names + "wndow" + wnd_cnt + ",";
  218. }
  219.  
  220. *-- Window for memo field {cap_first(FLD_FIELDNAME)}.
  221. DEFINE WINDOW { Window_Def(flds)}\
  222. {  endif
  223.  next flds
  224.  print(crlf);
  225.  if carry_flg then
  226. }
  227.  
  228. lc_carry = SET("CARRY")
  229. *-- Fields to carry forward during APPEND.
  230. SET CARRY TO { Carry_Flds()}
  231.  
  232. {endif}
  233. {
  234.  if check_for_popups() then
  235. }
  236.  
  237. ON KEY LABEL F2 ?? chr(7)
  238.  
  239. lc_proc = SET("procedure")                       && Store procedure file name
  240. SET PROCEDURE TO u_{substr(name,1,6)}
  241.  
  242. {    endif
  243.      if check_for_help() then
  244.         if !is_popup then}
  245. lc_proc = SET("procedure")                       && Store procedure file name
  246. SET PROCEDURE TO u_{substr(name,1,6)}
  247. {       endif}
  248. ON KEY LABEL F1 DO Help WITH VARREAD()
  249. {    endif
  250. return;
  251. // eof - fmt_file_init()
  252. enddef
  253.  
  254. //--------------------------------------------------------------
  255. define fmt_file_body()
  256. }
  257.  
  258. *-- @ SAY GETS Processing. -----------------------------------------------------
  259.  
  260. *--  Format Page: {page_cnt = 1
  261.                    page_cnt}
  262.  
  263. {line_cnt = wnd_cnt = 0
  264.  foreach ELEMENT k
  265.    color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  266.    if new_page(k) then
  267. }
  268. READ
  269.  
  270. *-- Format Page: {page_cnt}
  271.  
  272. {  endif
  273. //
  274.  
  275.    if ELEMENT_TYPE == @TEXT_ELEMENT or ELEMENT_TYPE == @FLD_ELEMENT then
  276.      if FLD_FIELDTYPE == calc then
  277. }
  278. *-- Calculated field: {cap_first(FLD_FIELDNAME)} - {FLD_DESCRIPT}
  279. {    endif
  280.      if FLD_FIELDTYPE == memvar then
  281. }
  282. *-- Memory variable: {cap_first(FLD_FIELDNAME)}
  283. {    endif}
  284. @ {nul2zero(ROW_POSITN) - line_cnt},{nul2zero(COL_POSITN)} \
  285. {  endif
  286.    if ELEMENT_TYPE == @BOX_ELEMENT then
  287. }
  288. @ {box_coordinates(k)}\
  289. {  endif}
  290. //
  291. {  case ELEMENT_TYPE of
  292.    @TEXT_ELEMENT:
  293.    // Certain control characters can cause dBASE problems ie, ASCII(13,26,0)
  294.    // so the form designer will either send them to us as a string if they are
  295.    // all the same character or as individual characters if they differ. We
  296.    // handle this by using the chr() function to "SAY" them in dBASE.
  297. }
  298. SAY \
  299. {     if asc(TEXT_ITEM) < 32 then
  300.         if len(TEXT_ITEM) == 1 then}
  301. CHR({asc(TEXT_ITEM)}) \
  302. {       else}
  303. REPLICATE(CHR({asc(TEXT_ITEM)}), {len(TEXT_ITEM)}) \
  304. {       endif
  305.       else
  306.          if substr(TEXT_ITEM,1,1) == "\"" then
  307.             // Double quote is being used on the design surface need to use
  308.             // brackets "[]" as delimiters
  309.             left_delimiter = "["
  310.             right_delimiter = "]"
  311.          endif
  312.          left_delimiter + TEXT_ITEM + right_delimiter} \
  313. {        left_delimiter = right_delimiter = "\""
  314.       endif
  315.       outcolor()}
  316. {  @Box_element:
  317.        outbox(BOX_TYPE, BOX_SPECIAL_CHAR)}
  318. {      outcolor()}
  319. {  @FLD_ELEMENT:
  320.       if !FLD_EDITABLE then; // its a SAY}
  321. SAY \
  322. {        if FLD_FIELDTYPE == calc then
  323.            // Loop thru expression in case it is longer than 237
  324.             foreach FLD_EXPRESSION fcursor in k
  325.                FLD_EXPRESSION}
  326. {           next}
  327. // Output a space after the Fld_expression and get ready for picture clause
  328.  \
  329. {        else // not a editable field
  330.             if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  331.                temp + cap_first(FLD_FIELDNAME)} \
  332. {        endif
  333.          if Ok_Template(k) then}
  334. PICTURE "{picture_for_say(k);}" \
  335. {        endif
  336.       else // it's a get}
  337. GET \
  338. {        if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
  339.          temp + cap_first(FLD_FIELDNAME)} \
  340. {        if chr(FLD_VALUE_TYPE) == "M" && FLD_MEM_TYP
  341.             and not (BOX_HEIGHT <= 3 and BOX_WIDTH <= 3) then    //Modified 8/3/90 B. Flynn
  342.             if wnd_cnt < 20  then ++wnd_cnt endif
  343.             if Fld_mem_typ == 1}OPEN {endif}WINDOW wndow{wnd_cnt} \
  344. {        endif
  345.          if Ok_Template(k) then}
  346. PICTURE "{picture_for_get(k);}" \
  347. {        endif
  348.          if FLD_L_BOUND or FLD_U_BOUND then color_flg = 1;}
  349. ;
  350. //Modified by B. Flynn.  8/3/90
  351.    RANGE {if get_required then}REQUIRED {endif}{FLD_L_BOUND}{if FLD_U_BOUND then},{FLD_U_BOUND}{endif} \
  352. {        endif
  353.          if FLD_OK_COND then color_flg = 1;}
  354. ;
  355. {           if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" and
  356.                ok_coordinates( k, 2, 1, bad_pick ) then
  357.                // A POPUP is desired for showing coded values, redo the
  358.                // VALID clause to call a UDF based on "U_" + FLD_FIELDNAME
  359. }
  360. //Modified by B. Flynn.  8/3/90
  361.    VALID {if is_required(FLD_OK_COND) or get_required}REQUIRED {endif}\
  362. {  get_udfname(FLD_FIELDNAME)}( {cap_first(FLD_FIELDNAME)} ) \
  363. {
  364.             else
  365.                 if !(at("POPUP", upper(ltrim(FLD_OK_COND))) == "2") then
  366. }
  367.    VALID {if get_required}REQUIRED {endif}{FLD_OK_COND} \
  368. {
  369.                 endif
  370.             endif
  371.  
  372.             if FLD_REJ_MSG then}
  373. ;
  374.    ERROR \
  375. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif}{FLD_REJ_MSG}\
  376. {              if !at("IIF", upper(FLD_REJ_MSG))}"{endif} \
  377. {           endif
  378.          endif // FLD_OK_COND
  379.          if FLD_ED_COND then color_flg = 1;}
  380. ;
  381.    WHEN {FLD_ED_COND} \
  382. {
  383.          endif
  384.          if FLD_DEF_VAL then color_flg = 1;}
  385. ;
  386.    DEFAULT {FLD_DEF_VAL} \
  387. {        endif
  388.          if FLD_HLP_MSG then color_flg = 1;}
  389. ;
  390.    MESSAGE \
  391. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif}{FLD_HLP_MSG}\
  392. {           if !at("IIF", upper(FLD_HLP_MSG))}"{endif} \
  393. {        endif
  394.       endif // FLD_EDITABLE
  395. }
  396. {     outcolor()}
  397. {     color_flg = 0;
  398.    otherwise: goto getnext;
  399.    endcase
  400. }
  401.  
  402. //Leave the above blank line, it forces a line feed!
  403. //-----------------
  404. // End of @ SAY GET
  405. //-----------------
  406. {  ++cnt;
  407.    getnext:
  408.  next k
  409. return;
  410. // eof - fmt_file_body()
  411. enddef
  412.  
  413. //--------------------------------------------------------------
  414. define fmt_file_exit()
  415. }
  416. *-- Format file exit code -----------------------------------------------------
  417.  
  418. *-- SET STATUS was \
  419. {if dB_status then}
  420. ON when you went into the Forms Designer.
  421. IF lc_status = "OFF"  && Entered form with status off
  422.    SET STATUS OFF     && Turn STATUS "OFF" on the way out
  423. {else}
  424. OFF when you went into the Forms Designer.
  425. IF lc_status = "ON"  && Entered form with status on
  426.    SET STATUS ON     && Turn STATUS "ON" on the way out
  427. {endif}
  428. ENDIF
  429. {if carry_flg then}
  430.  
  431. SET CARRY &lc_carry.
  432. {endif}
  433. SET CURSOR &lc_cursor.
  434. SET TALK &lc_talk.
  435. {if at("43", display_type()) then}
  436. SET DISPLAY TO &lc_display.      && Reset Screen size if changed
  437. {endif}
  438. {if wnd_names then}
  439.  
  440. RELEASE WINDOWS {substr(wnd_names, 1, (len(wnd_names) - 1))}
  441. {endif}
  442.  
  443. RELEASE {if carry_flg then}lc_carry,{endif}lc_talk,lc_fields,lc_status
  444. {    if is_help then}
  445.  
  446. ON KEY LABEL F1
  447. {    endif
  448.      if is_popup or is_help then}
  449. ON KEY LABEL F2
  450.  
  451. SET PROCEDURE TO (lc_proc)
  452. {    endif}
  453. *-- EOP: {filename(fmt_name)}FMT
  454. {return;
  455. // eof - fmt_file_exit()
  456. enddef
  457.  
  458. //--------------------------------------------------------------
  459. define picture_for_get(c)
  460.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  461. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  462.  {//leave this space}\
  463. {       endif
  464.      if at("M", c.FLD_PICFUN) then
  465.         c.FLD_PIC_CHOICE}\
  466. {    else
  467.         c.FLD_TEMPLATE}\
  468. {    endif
  469.  return;
  470. enddef
  471.  
  472. //--------------------------------------------------------------
  473. define picture_for_say(c)
  474.      if c.FLD_PICFUN then}@{c.FLD_PICFUN}\
  475. {       if at("S", c.FLD_PICFUN) then}{c.FLD_PIC_SCROLL}{endif}\
  476.  {//leave this space}\
  477. {       endif
  478.      if !at("M", c.FLD_PICFUN) then
  479.         c.FLD_TEMPLATE}\
  480. {    endif
  481.  return;
  482. enddef
  483.  
  484. //--------------------------------------------------------------
  485. define make_pop_code()
  486. // Create the Procedure File for POPUP's if required
  487.      if is_popup then
  488.           if !make_udf() then 
  489.               return 0;
  490.           endif
  491.           udf_header()
  492. }
  493. FUNCTION Empty                && Determine if the passed argument is NULL
  494. PARAMETER x
  495.   mtype = TYPE("x")
  496.   DO CASE
  497.     CASE mtype = "C"
  498.       retval = (LEN(TRIM(x))=0)
  499.     CASE mtype$"NF"
  500.       retval = (x=0)
  501.     CASE mtype = "D"
  502.       retval = (" "$DTOC(x))
  503.   ENDCASE
  504. *-- EOP: empty
  505. RETURN (retval)
  506.  
  507. {
  508.           line_cnt = 0
  509.           page_cnt = 1
  510.  
  511.           foreach FLD_ELEMENT flds
  512.  
  513.                at_pop = at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" ? 1 : 0;
  514.  
  515.                new_page(flds)
  516.                if at_pop then
  517.                     trow_positn = nul2zero(ROW_POSITN) - line_cnt
  518.                     tcol_positn = nul2zero(COL_POSITN)
  519.                     color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
  520.  
  521.                     if !ok_coordinates(flds, 2, 0, "") then loop endif
  522.  
  523.  
  524.                     print("*"+replicate("-",78)+crlf);}
  525. FUNCTION {get_udfname(FLD_FIELDNAME)}
  526.   PARAMETER fld_name
  527.   PRIVATE ALL LIKE ??_*
  528.   PRIVATE esckey, fld_name, rtn_fld
  529.   ll_return = .F.
  530.  
  531. {                   if !is_required(FLD_OK_COND) then}
  532.   IF empty(fld_name)                   && Not a required fiel cur.FLD_TEMPLATE
  533.      RETURN (.T.)                       && if null field
  534.   ENDIF
  535.  
  536. {                    endif}
  537.   EscKey = 27                          && 27 represents the ESC key
  538.  
  539.   lc_alias = ALIAS()                   && Grab current workarea
  540.   SELECT SELECT()
  541.   USE {get_file(FLD_OK_COND)} ORDER {get_key(FLD_OK_COND)} AGAIN
  542.  
  543.  
  544.   lc_exact = SET("EXACT")              && Store value of EXACT
  545.   SET EXACT ON
  546.  
  547. {                   if chr(FLD_VALUE_TYPE) == "C" then}
  548.   fld_name = IIF( EMPTY( TRIM( fld_name)), fld_name, TRIM( fld_name))
  549. {                   endif}
  550.   SEEK fld_name
  551.  
  552.   SET EXACT &lc_exact.                 && Restore SET EXACT to org. value
  553.   IF .NOT. FOUND()
  554.  
  555.       DEFINE POPUP {get_popname(FLD_OK_COND)} FROM \
  556. {         if trow_positn < max_pop_row then
  557.              trow_positn + 1},{tcol_positn} ;
  558.         TO {scrn_size-1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  559. {         else
  560.              trow_positn - 11},{tcol_positn} ;
  561.         TO {trow_positn - 1},{tcol_positn + len(FLD_TEMPLATE) + 1} ;
  562. {         endif}
  563.         PROMPT FIELD {get_field(FLD_OK_COND)} ;
  564.         MESSAGE {select_msg1}
  565.  
  566.       ON SELECTION POPUP {get_popname(FLD_OK_COND)} DEACTIVATE POPUP
  567.  
  568. //Modified 8/3/90 B. Flynn
  569. //{                        if chr(FLD_VALUE_TYPE) == "C" then}    
  570. //      KEYBOARD TRIM(fld_name)
  571. //{                   endif}
  572.       SAVE SCREEN TO temp
  573. {                   if is_shadow(FLD_OK_COND) and
  574.                        ok_coordinates( flds, 4, 1, bad_shadow ) then
  575. }
  576.       DO shadowg WITH {get_pop_shadow(FLD_TEMPLATE);}
  577.  
  578. {                   endif
  579. }
  580.       ACTIVATE POPUP {get_popname(FLD_OK_COND)}
  581.  
  582.       rtn_fld = PROMPT()                         && Get user choice from Piclist
  583.  
  584.       RELEASE POPUP {get_popname(FLD_OK_COND)}
  585.  
  586.       RESTORE SCREEN FROM temp
  587.  
  588.       IF LASTKEY() <> EscKey
  589.         @ {trow_positn},{tcol_positn} GET rtn_fld \
  590. {        if Ok_Template(flds) then}
  591. PICTURE "{picture_for_get(flds);}" \
  592. {           outcolor()}
  593. {        endif}
  594.  
  595.         CLEAR GETS
  596.  
  597.         REPLACE {cap_first(FLD_FILENAME)}->{cap_first(FLD_FIELDNAME)} WITH \
  598. {        if chr(FLD_VALUE_TYPE) == "C" then}
  599. rtn_fld
  600. {        else}
  601. VAL(rtn_fld)
  602. {        endif}
  603.  
  604.         ll_return = .T.
  605.       ELSE
  606.         ll_return = .F.
  607. {
  608.                     if !is_required(FLD_OK_COND) then
  609. }
  610.         IF EMPTY(fld_name)               && Not a required field, so return
  611.           ll_return = .T.
  612.         ENDIF
  613.  
  614. {
  615.                     endif
  616. }
  617.       ENDIF
  618.  
  619.   ELSE
  620.       ll_return = .T.
  621.   ENDIF
  622.  
  623.   USE
  624.   SELECT (lc_alias)                    && Go back to the edit file
  625.  
  626. *-- EOP: {get_udfname(FLD_FIELDNAME)}
  627. RETURN (ll_return)
  628.  
  629. {
  630.                endif
  631.           next flds
  632.           print("*"+replicate("-",78)+crlf);}
  633.  
  634. {    endif
  635.      return;
  636. // eof - make_pop_code()
  637. enddef
  638.  
  639. //--------------------------------------------------------------
  640. define make_help_code()
  641. //------------------------------------
  642. // Make procedures for the help system
  643. //------------------------------------
  644. if is_help then
  645.      // If the udf file has not already been created, make it.
  646.     if not udf_file then
  647.        if !make_udf() then 
  648.            return 0;
  649.        endif
  650.        // Put up the UDF header
  651.        udf_header()
  652.     endif
  653.     // Make procedures for the help system
  654.     make_help()
  655. endif
  656. if is_help or is_popup then
  657.    // Make shadow procedures
  658.    make_shadow_procs()
  659. endif
  660. return;
  661. enddef
  662.  
  663. //--------------------------------------------------------------
  664. define header()
  665.     // Print Header in program
  666.     print( replicate( "*",80) + crlf);}
  667. *-- Name.......: {filename(fmt_name)}FMT
  668. *-- Date.......: {ltrim( substr( date(),1,8))}
  669. *-- Version....: dBASE IV, Format {FRAME_VER}.1
  670. *-- Notes......: Format files use "" as delimiters!
  671. {   print( replicate( "*",80) + crlf);
  672. enddef
  673.  
  674. //--------------------------------------------------------------
  675. define udf_header()
  676.     // Print Header in UDF program
  677.     print("*"+replicate("-",78)+crlf);}
  678. *-- Name....: {frame_path}u_{rtrim(substr(name,1,6))}.PRG
  679. *-- Date....: {ltrim(SUBSTR(date(),1,8))}
  680. *-- Version.: dBASE IV, Procedure for Format {Frame_ver}.1
  681. *-- Notes...: Procedure file for VALID POPUPs and/or Context Sensitive Help
  682. *-- ........: for {filename(fmt_name)}FMT
  683. {print("*"+replicate("-",78)+crlf);
  684. enddef
  685.  
  686. //--------------------------------------------------------------
  687. define ok_template(cur)
  688.      if cur.FLD_TEMPLATE && !(chr(cur.FLD_VALUE_TYPE) == "D" ||
  689.                               chr(cur.FLD_VALUE_TYPE) == "M") then
  690.         return 1;
  691.      else
  692.         return 0;
  693.      endif
  694. enddef
  695.  
  696. //--------------------------------------------------------------
  697. define ok_coordinates(cur,              // Current cursor
  698.                       xtra_width,       // Additional width to check ie, shadow
  699.                       want_message,     // Display message flag 0:No 1:Yes
  700.                       message)          // Message to display to user
  701.      // Check to see if coordinates of popup or shadow will fit on screen
  702.      // based on the dimensions of the current field
  703.      if nul2zero(cur.COL_POSITN) + len(cur.FLD_TEMPLATE) + xtra_width > 80 then
  704.         if want_message then
  705.            beep(2)                      // UDF in builtin.def
  706.            cls()
  707.            say_center(10,"Error on Field: " + cur.FLD_FIELDNAME)
  708.            say_center(12, message)
  709.            pause(any_key)
  710.         endif
  711.         return 0;
  712.      else
  713.         return 1;
  714.      endif
  715. enddef
  716.  
  717. //--------------------------------------------------------------
  718. define screen_size()
  719.    // Test screen size if display > 2 screen is 43 lines
  720.    display = numset(_flgcolor)
  721.    if display > ega25 then
  722.        scrn_size = 39
  723.        max_pop_row = 36
  724.    else
  725.        max_pop_row = 18
  726.        scrn_size = 21
  727.    endif
  728.  
  729.    // Test to see if status was off before going into form designer
  730.    dB_status = numset(_flgstatus)
  731.    if scrn_size == 21 and !db_status then
  732.       scrn_size = 24
  733.       max_pop_row = 21
  734.    endif
  735.    if scrn_size == 39 and !db_status then // status is off
  736.       scrn_size = 42
  737.       max_pop_row = 39
  738.    endif
  739.    return;
  740. enddef
  741.  
  742. //--------------------------------------------------------------
  743. define display_type()
  744.     // Find out the display type we are working on
  745.     var temp;
  746.     case display of
  747.        mono:   temp = "MONO"
  748.        cga:    temp = "COLOR"
  749.        ega25:  temp = "EGA25"
  750.        mono43: temp = "MONO43"
  751.        ega43:  temp = "EGA43"
  752.      endcase
  753.      return temp;
  754. enddef
  755.  
  756. //--------------------------------------------------------------
  757. define getcolor(f_display,         // Color of the current field
  758.                 f_editable         // Field is SAY or GET
  759.                )
  760.  // Determines the color from f_display and f_editable (GET or SAY)
  761.  enum  Foreground  =   7,
  762.        Intensity   =   8,  // Color
  763.        Background  = 112,
  764.        MIntensity  = 256,
  765.        Reverse     = 512,  // Mono
  766.        Underline   =1024,
  767.        Blink       =2048,
  768.        default     =32768; // Screen set to default
  769.  
  770.  var forgrnd, enhanced, backgrnd, blnk, underln, revrse, use_colors, incolor;
  771.  incolor=""
  772.  
  773.  use_colors  = default & f_display
  774.  forgrnd  = Foreground & f_display
  775.  enhanced = (Intensity & f_display) || (MIntensity & f_display)
  776.  backgrnd = Background & f_display
  777.  blnk     = Blink  & f_display
  778.  underln  = Underline & f_display
  779.  revrse   = Reverse & f_display
  780.  
  781.  if not use_colors then // Use system colors, no colors set in designer
  782.  
  783.     if backgrnd then backgrnd = backgrnd/16 endif
  784.  
  785.     if (display != mono and display != mono43) then
  786.        case forgrnd of
  787.         0: incolor = "n"
  788.         1: incolor = "b"
  789.         2: incolor = "g"
  790.         3: incolor = "bg"
  791.         4: incolor = "r"
  792.         5: incolor = "rb"
  793.         6: incolor = "gr"
  794.         7: incolor = "w"
  795.        endcase
  796.     else
  797.        incolor = "w"
  798.     endif
  799.  
  800.     if revrse then
  801.        incolor = incolor + "i"
  802.     endif
  803.     if underln then
  804.        incolor = incolor + "u"
  805.     endif
  806.     if enhanced then
  807.        incolor = incolor + "+"
  808.     endif
  809.     if blnk then
  810.        incolor = incolor + "*"
  811.     endif
  812.  
  813.     incolor = incolor + "/"
  814.  
  815.     if (display != mono and display != mono43) then
  816.        case backgrnd of
  817.         0: incolor = incolor + "n"
  818.         1: incolor = incolor + "b"
  819.         2: incolor = incolor + "g"
  820.         3: incolor = incolor + "bg"
  821.         4: incolor = incolor + "r"
  822.         5: incolor = incolor + "rb"
  823.         6: incolor = incolor + "gr"
  824.         7: incolor = incolor + "w"
  825.        endcase
  826.     else
  827.        incolor = incolor + "n"
  828.     endif
  829.  
  830.     if f_editable and incolor then
  831.        incolor = incolor + "," + incolor
  832.     endif
  833.  
  834.  endif // use no colors
  835.  return alltrim(incolor);
  836. enddef
  837.  
  838. //--------------------------------------------------------------
  839. define outbox(mbox,            // Border type
  840.               mchar            // Special character of border
  841.              )
  842.    // Output the of Box border and character if any
  843.    var result;
  844.    case mbox of
  845.       0: result = " " // single
  846.       1: result = " DOUBLE "
  847.       2: result = " CHR("+mchar+") "
  848.    endcase
  849.    return result;
  850. enddef
  851.  
  852. //--------------------------------------------------------------
  853. define outcolor()
  854.   // Output the of color of the @ SAY GET or Box
  855.   var result;
  856.   result = "";
  857.   if len(color) > 0 then
  858.      if color_flg then
  859.         // If flag is set output a dBASE continuation ";"
  860.         result = ";" + crlf + space(3)
  861.      endif
  862.      result = result + "COLOR " + color + " "
  863.   endif
  864.   return result;
  865. enddef
  866.  
  867. //--------------------------------------------------------------
  868. define window_def(cur)
  869.    // Build dBASE window command
  870.    var result;
  871.    result = "wndow" + wnd_cnt + " FROM " + Box_Coordinates(cur)
  872.    result = result + outbox(cur.BOX_TYPE, cur.BOX_SPECIAL_CHAR)
  873.    color = getcolor(cur.FLD_DISPLAY, cur.FLD_EDITABLE)
  874.    result = result + outcolor()
  875.    return result;
  876. enddef
  877.  
  878. //--------------------------------------------------------------
  879. define box_coordinates(cur)             // Pass in foreach cursor
  880.    // Build box coordinates for a dBASE window command
  881.    var result, temp_page, line_cnt;
  882.    temp_page = page_cnt;
  883.  
  884.    // Adjust box coordinates so that negative numbers are not generated
  885.    do while ( nul2zero(cur.BOX_TOP) - (scrn_size * temp_page) ) <= 1
  886.          temp_page = temp_page - 1
  887.    enddo
  888.    if page_cnt == 1 then
  889.         temp_page = 0
  890.    endif
  891.    if page_cnt == 2 then
  892.         temp_page = 1
  893.    endif
  894.    if !temp_page then
  895.       line_cnt = 0
  896.    else
  897.       line_cnt = (scrn_size * temp_page) + (1 * temp_page)
  898.    endif
  899.  
  900.    result = nul2zero(cur.BOX_TOP) - line_cnt +","
  901.    result = result + nul2zero(cur.BOX_LEFT) + " TO "
  902.    temp = nul2zero(cur.BOX_TOP) + cur.BOX_HEIGHT - line_cnt - 1
  903.    if temp > scrn_size then temp = scrn_size endif
  904.    result = result + temp + "," + (nul2zero(cur.BOX_LEFT) + cur.BOX_WIDTH - 1)
  905.    return result;
  906. enddef
  907.  
  908. //--------------------------------------------------------------
  909. define carry_flds()
  910.    // Build dBASE SET CARRY command
  911.    carry_len = carry_lent = 13
  912.    carry_first = 0
  913.    foreach FLD_ELEMENT flds
  914.       if FLD_CARRY then
  915.          carry_len = carry_len + len(FLD_FIELDNAME + ",")
  916.          carry_lent = carry_lent + len(FLD_FIELDNAME + ",")
  917.          if carry_lent > 1000 then
  918.             print(crlf + "SET CARRY TO ")
  919.             carry_len = carry_lent = 13
  920.          endif
  921.          if carry_len > 75 then print(";" + crlf + "  ")  carry_len = 2 endif
  922.          temp = cap_first(FLD_FIELDNAME)
  923.          if !carry_first then
  924.             print(temp)
  925.             carry_first = 1
  926.          else
  927.             print("," + temp)
  928.          endif
  929.       endif
  930.     next flds
  931.     print(" ADDITIVE");
  932.  return;
  933. enddef
  934.  
  935. //--------------------------------------------------------------
  936.  
  937. define make_fmt()
  938.    // Attempt to create program (fmt) file.
  939.    default_drv = strset(_defdrive)  // grab default drive from dBASE
  940.    fmt_name = FRAME_PATH + NAME     // Put path on to object name
  941.    if not fileok(fmt_name) then
  942.       if !default_drv then
  943.          fmt_name = NAME
  944.       else
  945.          fmt_name = default_drv + ":" + NAME
  946.       endif
  947.    endif
  948.    fmt_name = upper(fmt_name)
  949.    if not create(fmt_name+".FMT") then
  950.         pause(fileroot(fmt_name) +".FMT" + read_only + any_key)
  951.         return 0;
  952.      endif
  953.    return 1;
  954. enddef
  955. //--------------------------------------------------------------
  956.  
  957. define make_udf()
  958.    // Attempt to create dBASE procedure (prg) file.
  959.    var udf_root_file_name;
  960.    udf_root_file_name =  frame_path + "u_" + rtrim(substr(name,1,6))
  961.    if not create( udf_root_file_name + ".PRG") then
  962.       pause(udf_root_file_name + ".PRG" + read_only + any_key)
  963.       return 0;
  964.    endif
  965.    // Force dBASE to recompile the .prg
  966.    fileerase(udf_root_file_name + ".DBO")
  967.    udf_file = 1 // Global flag to determine if UDF file was created
  968.    return 1;
  969. enddef
  970.  
  971. //--------------------------------------------------------------
  972. define check_for_popups()
  973. // Check for "popup" string for this fmt file
  974. foreach FLD_ELEMENT flds
  975.     if at("POPUP", upper(ltrim(FLD_OK_COND))) == "2" then
  976.        is_popup = 1
  977.        exit
  978.     endif
  979. next flds
  980. return is_popup;
  981. enddef
  982.  
  983. //--------------------------------------------------------------
  984. define check_for_help()
  985.    // Check for help support for this fmt file
  986.    // Looking for a .dBF with the same name as the .fmt file
  987.    hlp_name = frame_path + substr(fileroot(fmt_name), 1, 6) + "_H"
  988.  
  989.    if fileexist(hlp_name + ".DBF") and fileexist(hlp_name + ".DBT") then
  990.       is_help = 1      // Global flag for help support
  991.    endif
  992. return is_help;
  993. enddef
  994.  
  995. //--------------------------------------------------------------
  996. define new_page(cur)               // Cur: Current cursor
  997.    // Checks for a page break and adjusts line_cnt and page_cnt
  998.    if nul2zero(cur.ROW_POSITN) - line_cnt > scrn_size then
  999.       line_cnt = line_cnt + scrn_size + 1;
  1000.       ++page_cnt;
  1001.       return 1;
  1002.    endif
  1003. return 0;
  1004. enddef
  1005.  
  1006. //--------------------------------------------------------------
  1007. define parse_line( before,         // Out: chars before the look_for string
  1008.                    input,          // In:  line being parsed
  1009.                    look_for        // In:  string searched for
  1010.                  )                 // Rtn: chars after the look_for string
  1011. // If the look_for sting is not found, the before sting will equal the
  1012. // input string, and the returned value will be NUL
  1013.      var location;
  1014.  
  1015.      location = at(look_for, UPPER(input))
  1016.      if location == 0 then
  1017.           before = input
  1018.           return ( "" );
  1019.      endif
  1020.  
  1021.      before = substr( input, 1, location-1)
  1022.      return ( substr( input,
  1023.                       location+len(look_for),
  1024.                       len(input)
  1025.                     )
  1026.             );
  1027.  
  1028. // end: parse_line()
  1029. enddef
  1030.  
  1031. //--------------------------------------------------------------
  1032. // Parsing routines for pulling objects out of the VALID string
  1033. // "POPUP" = "file->fld_name ORDER key_fld REQ"
  1034. // 1234567890123456789012345678901234567890123
  1035. //            1         2         3         4
  1036. define get_file(valid_str)
  1037.      var  s_arrow,            // String "->"
  1038.           test,
  1039.           s_equal,            // String "="
  1040.           next_alpha,
  1041.           at_alias,
  1042.           s_before,           // String before the searched for item
  1043.           r_target,           // Remainder of the target string after item
  1044.           use_name;           // Return for file
  1045.  
  1046.      s_arrow = "->"
  1047.      s_equal = "="
  1048.      r_target = parse_line( s_before, valid_str, s_equal )      // ' "file->...'
  1049.      next_alpha = atalpha(r_target)                             // 3
  1050.      at_alias = at(s_arrow, r_target)                           // 7
  1051.      use_name = substr(r_target,next_alpha,at_alias-next_alpha) // 'file'
  1052.  
  1053.      return cap_first(use_name);
  1054. enddef
  1055.  
  1056. //--------------------------------------------------------------
  1057. define get_key(valid_str)
  1058.      var  s_order,            // String "ORDER "
  1059.           at_space,
  1060.           s_before,           // String before the searched for item
  1061.           r_target,           // Remainder of the target string after item
  1062.           order_tag;          // Search TAG to ORDER BY
  1063.  
  1064.      s_order = "ORDER "
  1065.      r_target = parse_line( s_before, valid_str, s_order ) // 'key_fld REQ'
  1066.      at_space = at(" ",r_target)
  1067.      if at_space == 0 then
  1068.           order_tag = substr(r_target, 1, len(r_target)-1) // 'key_fld"'
  1069.      else
  1070.           order_tag = substr(r_target, 1, at_space-1)
  1071.      endif
  1072.      return cap_first(order_tag);
  1073. enddef
  1074.  
  1075. //--------------------------------------------------------------
  1076. define get_field(valid_str)
  1077.      var  s_arrow,            // String "->"
  1078.           at_space,
  1079.           s_before,           // String before the searched for item
  1080.           r_target,           // Remainder of the target string after item
  1081.           fld_name;           // Field name to lookup in target file
  1082.  
  1083.      s_arrow = "->"
  1084.      r_target = parse_line( s_before,
  1085.                             valid_str, s_arrow ) // 'fld_name ORDER...'
  1086.      at_space = at(" ",r_target)
  1087.  
  1088.      fld_name = ( at_space == 0 ? r_target : substr(r_target, 1, at_space-1) );
  1089.  
  1090.      return cap_first(fld_name);
  1091. enddef
  1092.  
  1093. //--------------------------------------------------------------
  1094. define get_popname(valid_str)
  1095.      // Create popup name
  1096.      return ( lower( "u_" + substr( get_field( valid_str),1,6) ) );
  1097. enddef
  1098.  
  1099. //--------------------------------------------------------------
  1100. define get_pop_shadow(field_template)   // Pass in FLD_TEMPLATE to deter. shadow
  1101.      if trow_positn < max_pop_row then
  1102.         trow_positn + 1},{tcol_positn},{scrn_size-1},{tcol_positn+len(Field_template)+1}
  1103. {    else
  1104.         trow_positn - 11},{tcol_positn},{trow_positn - 1},{tcol_positn+len(Field_template)+1}
  1105. {    endif
  1106.      return;
  1107. enddef
  1108.  
  1109. //---------------------------------------------------------------
  1110. define get_udfname(fld_str)
  1111.      // Create UDF name
  1112.      return cap_first( "u_" + substr( fld_str,1,6) );
  1113. enddef
  1114.  
  1115. //--------------------------------------------------------------
  1116. define is_required(valid_str)
  1117.      // Determines if the field is required before moving to the next field
  1118.      return ( ( at(" REQ ",  upper(valid_str)) ? 1 : 0 ) or 
  1119.               ( at(" REQ\"", upper(valid_str)) ? 1 : 0 )
  1120.             );
  1121. enddef
  1122.  
  1123. //--------------------------------------------------------------
  1124. define is_shadow(valid_str)
  1125.      // Determines if the user wants shadowing for popup
  1126.      return ( ( at(" SHADOW ",  upper(valid_str)) ? 1 : 0 ) or 
  1127.               ( at(" SHADOW\"", upper(valid_str)) ? 1 : 0 )
  1128.             );
  1129. enddef
  1130.  
  1131. //--------------------------------------------------------------
  1132. define make_shadow_procs()
  1133.      // Make the dBASE code for shadowing
  1134.      print("*"+replicate("-",78)+crlf);
  1135. }
  1136. PROCEDURE Shadowg                       && displays shadow that grows
  1137.   PARAMETER x1,y1,x2,y2
  1138.   PRIVATE   x1,y1,x2,y2
  1139.  
  1140.   x0 = x2+1
  1141.   y0 = y2+2
  1142.   dx = 1
  1143.   dy = (y2-y1) / (x2-x1)
  1144.   DO WHILE x0 <> x1 .OR. y0 <> y1+2
  1145.      @ x0,y0 FILL TO x2+1,y2+2 COLOR n+/n
  1146.      x0 = IIF(x0<>x1,x0 - dx,x0)
  1147.      y0 = IIF(y0<>y1+2,y0 - dy,y0)
  1148.      y0 = IIF(y0<y1+2,y1+2,y0)
  1149.   ENDDO
  1150.  
  1151. RETURN
  1152. *-- EOP: shadowg
  1153. {    return;
  1154. enddef
  1155.  
  1156. //--------------------------------------------------------------
  1157.  define make_help()
  1158. // Make the dBASE code for help
  1159. }
  1160. PROCEDURE Help
  1161. {    lmarg(offset)}
  1162. *-- Activates the HELP window
  1163. PARAMETER lc_var
  1164. PRIVATE ALL LIKE ??_*
  1165. SET CURSOR OFF
  1166.  
  1167. *-- Select workarea and open Help dbf
  1168. lc_area = ALIAS()
  1169. SELECT SELECT()
  1170. USE {fileroot(hlp_name)} ORDER fld_name NOUPDATE   && Open HELP .dbf
  1171.  
  1172. SEEK lc_var
  1173. IF FOUND()                             && If found show Help
  1174.   ln_t = 5
  1175.   ln_l = 6
  1176.   ln_b = 15
  1177.   ln_r = 74
  1178.   ON KEY LABEL F3 DO Toggle
  1179.   DEFINE WINDOW z_help FROM ln_t+1, ln_l+2 TO ln_b-1, ln_r-2 NONE
  1180.   ON ERROR lc_error=error()
  1181.   SAVE SCREEN TO zz_help
  1182.  
  1183.   *-- Make Help Box
  1184.   DO shadowg WITH ln_t, ln_l, ln_b, ln_r
  1185.   @ ln_t+1, ln_l+1 CLEAR TO ln_b-1, ln_r-1
  1186.   @ ln_t, ln_l TO ln_b, ln_r DOUBLE
  1187.  
  1188.   ln_memline = SET("MEMO")
  1189.   SET MEMOWIDTH TO 65
  1190.   IF MEMLINES(fld_help) > 9
  1191.     @ ln_t+1,ln_r SAY CHR(24)
  1192.     @ ln_b-1,ln_r SAY CHR(25)
  1193.   ENDIF
  1194.   lc_string = CHR(185)+ [ Help for ] + TRIM(fld_headng) +[ ] + CHR(204)
  1195.   lc_message = IIF(MEMLINES(fld_help) > 9, ;
  1196.                   "{help_msg1 + help_msg2}", ;
  1197.                   "{help_msg2}" ;
  1198.                   )
  1199.  
  1200.   @ ln_t,CENTER(lc_string,80) SAY lc_string
  1201.   @ 0,0 GET fld_help OPEN WINDOW z_help MESSAGE lc_message
  1202.   READ
  1203.   SET MEMOWIDTH TO ln_memline
  1204.   ON ERROR
  1205.   ON KEY LABEL F3
  1206.   RELEASE WINDOW z_help
  1207.   RESTORE SCREEN FROM zz_help
  1208.   RELEASE SCREEN zz_help
  1209. ENDIF
  1210. SET MESSAGE TO
  1211. SET CURSOR ON
  1212. USE                                              && Close help file
  1213. SELECT (lc_area)                                 && Back to edit work area
  1214. {    lmarg(0)}
  1215. RETURN
  1216. *-- EOP: HELP
  1217.  
  1218. {    print("*"+replicate("-",78)+crlf);}
  1219. PROCEDURE Toggle
  1220. {    lmarg(offset)}
  1221. *-- Toggles the Help message back to the original screen
  1222. SAVE SCREEN to Toggle
  1223. RESTORE SCREEN FROM zz_help
  1224. SET MESSAGE TO "Press any key..."
  1225. mwait = INKEY(15)
  1226. RESTORE SCREEN FROM Toggle
  1227. RELEASE SCREEN Toggle
  1228. SET MESSAGE TO "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Ctrl-End   See Org. Screen: F3"
  1229. {    lmarg(0)}
  1230. RETURN
  1231. *-- EOP: Toggle
  1232.  
  1233. {    print("*"+replicate("-",78)+crlf);}
  1234. FUNCTION Center
  1235. *-- UDF to center a string.
  1236. *-- lc_string = String to center
  1237. *-- ln_width = Width of screen to center in
  1238. *--
  1239. *-- Ex. @ 15,center(string,80) say string
  1240. *-- Will center the <string> withing 80 columns
  1241. PARAMETER lc_string, ln_width
  1242. RETURN ((ln_width/2)-(LEN(lc_string)/2))
  1243. {return;
  1244. enddef
  1245. // EOP FORM.COD
  1246. }
  1247.